perm filename PLT.F4[1,LCS] blob
sn#577303 filedate 1981-04-10 generic text, type T, neo UTF8
C>BM=66 LM=1 TM=1 J=N
DIMENSION NN(3,500),MM(100)
C REAL*8 BLANK,VENUS,NAME
C INTEGER*1 NA,ISTAR,MM,IBLA
DATA ID/21/,IBLA/' '/,ISTAR/42/,BLANK/' '/,VENUS/'V'/
89 FORMAT(' TYPE FILE NAME ')
WRITE(5,89)
91 FORMAT(A5)
92 FORMAT(1XA5)
READ(5,91)NAME
WRITE(5,92)NAME
C IF(NAME.EQ.BLANK)NAME=VENUS
WRITE(5,93)
READ(5,1)JWIDTH
IF(JWIDTH.LT.80)JWIDTH=80
IF(JWIDTH.GT.100)JWIDTH=100
93 FORMAT(' TYPE NUMBER OF CHARACTERS/LINE ')
94 FORMAT(' TYPE "Y" SIZE FACTOR. (0=1) ')
95 FORMAT(1F6.3)
WRITE(5,94)
READ(5,95)YSIZE
IF(YSIZE.LT.0.2)YSIZE=1.0
WRITE(5,95)YSIZE
C CALL OPEN(1,NAME,256)
CALL IFILE(1,NAME)
C WRITE(5,88)
C READ(5,1)ISTAR
C WRITE(5,30)ISTAR
ISTAR='*'
96 FORMAT(' TYPE HORIZONTAL DISPLACEMENT ')
WRITE(5,96)
READ(5,1)JDIS
88 FORMAT(' TYPE CHARACTER NUMBER ')
1 FORMAT(3I)
30 FORMAT(1X,3I4)
N=0
KK=1
100 READ(1,1,END=90)I,J,K
IF(I.LT.0)GO TO 90
C -1 ENDS INPUT
NN(1,KK)=I+JDIS
NN(3,KK)=K
A=J*YSIZE
J=A
IF(N.LT.J)N=J
NN(2,KK)=J
KK=KK+1
GO TO 100
90 DO 7 K=1,JWIDTH
7 MM(K)=IBLA
12 LL=1
KA=1
2 K=NN(1,LL)
L=NN(2,LL)
M=NN(3,LL)
IF(M.LT.0)GO TO 80
9 IF(M.EQ.0)GO TO 3
5 I=K
J=L
C SAVE PREVIOUS POINT
GO TO 80
10 I=1
IF(NN(3,LL+1).NE.0)I=-I
NN(3,LL)=I
C MARK SEGS ENTIRELY ABOVE CURRENT LINE.
GO TO 5
3 IF(L.LT.N.AND.J.LT.N)GO TO 5
IF(L.GT.N.AND.J.GT.N)GO TO 10
C JUMP IF BOTH Y COORDS ARE LOWER THAN THIS LINE.
8 X=K-I
IF(X.NE.0)GO TO 13
M=K
C VERTICAL LINE
IF(M.GT.JWIDTH)GO TO 5
GO TO 14
13 Y=L-J
IF(Y.NE.0)GO TO 15
IF(K.GT.I)GO TO 16
JA=K
JB=I
GO TO 17
16 JA=I
JB=K
17 IF(JB.GT.JWIDTH)JB=JWIDTH
IF(JA.GT.JWIDTH)JA=JWIDTH
DO 18 M=JA,JB
18 MM(M)=ISTAR
C HORIZONTAL LINE
NN(3,LL)=1
M=JB
GO TO 19
C LENGTHS OF X AND Y SEGMENTS
15 IF(K.LT.I)GO TO 40
JK=K
JI=I
JJ=J
JL=L
GO TO 41
40 JK=I
JI=K
JJ=L
JL=J
JJ=L
41 X=JK-JI
Y=JL-JJ
UU=JI+.5
A=N-JJ
U=JJ+.5
H=Y/X
NA=0
DO 42 JC=JI,JK
V=JC-JI
LA=H*V+U
IF(LA.LT.N)GO TO 43
IF(LA.EQ.N)GO TO 45
IF(NA.LT.0)GO TO 44
NA=1
GO TO 42
43 IF(NA.GT.0)GO TO 44
NA=-1
GO TO 42
44 B=A/H+UU
M=B
GO TO 46
45 M=JC
46 NA=0
IF(M.GT.JWIDTH)GO TO 42
MM(M)=ISTAR
IF(M.GT.KA)KA=M
42 CONTINUE
GO TO 5
14 MM(M)=ISTAR
C SOLID GRAPHICS CHAR.
19 IF(M.GT.KA)KA=M
IF(KA.GT.JWIDTH)KA=JWIDTH
GO TO 5
80 LL=LL+1
IF(LL.LT.KK)GO TO 2
C GO BACK AND LOOK AT MORE VECTORS
C WRITE(5,20)(MM(K),K=1,KA)
WRITE(ID,20)(MM(K),K=1,KA)
N=N-1
IF(N.GE.0)GO TO 90
WRITE(ID,20)IBLA
C SO LAST REAL LINE WILL PRINT
20 FORMAT(1X,100A1)
END